home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / src-16f.lha / compiler / mips / values.lisp < prev    next >
Encoding:
Text File  |  1991-11-06  |  3.0 KB  |  101 lines
  1. ;;; -*- Package: C; Log: C.Log -*-
  2. ;;;
  3. ;;; **********************************************************************
  4. ;;; This code was written as part of the CMU Common Lisp project at
  5. ;;; Carnegie Mellon University, and has been placed in the public domain.
  6. ;;; If you want to use this code or any part of CMU Common Lisp, please contact
  7. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
  8. ;;;
  9. (ext:file-comment
  10.   "$Header: values.lisp,v 1.12 91/02/20 15:15:29 ram Exp $")
  11. ;;;
  12. ;;; **********************************************************************
  13. ;;;
  14. ;;; $Header: values.lisp,v 1.12 91/02/20 15:15:29 ram Exp $
  15. ;;;
  16. ;;;    This file contains the implementation of unknown-values VOPs.
  17. ;;;
  18. ;;; Written by Rob MacLachlan
  19. ;;;
  20. ;;; Converted for MIPS by William Lott.
  21. ;;; 
  22.  
  23. (in-package "MIPS")
  24.  
  25. (define-vop (reset-stack-pointer)
  26.   (:args (ptr :scs (any-reg)))
  27.   (:generator 1
  28.     (move csp-tn ptr)))
  29.  
  30.  
  31. ;;; Push some values onto the stack, returning the start and number of values
  32. ;;; pushed as results.  It is assumed that the Vals are wired to the standard
  33. ;;; argument locations.  Nvals is the number of values to push.
  34. ;;;
  35. ;;; The generator cost is pseudo-random.  We could get it right by defining a
  36. ;;; bogus SC that reflects the costs of the memory-to-memory moves for each
  37. ;;; operand, but this seems unworthwhile.
  38. ;;;
  39. (define-vop (push-values)
  40.   (:args
  41.    (vals :more t))
  42.   (:results
  43.    (start :scs (any-reg))
  44.    (count :scs (any-reg)))
  45.   (:info nvals)
  46.   (:temporary (:scs (descriptor-reg)) temp)
  47.   (:temporary (:scs (descriptor-reg)
  48.            :to (:result 0)
  49.            :target start)
  50.           start-temp)
  51.   (:generator 20
  52.     (move start-temp csp-tn)
  53.     (inst addu csp-tn csp-tn (* nvals vm:word-bytes))
  54.     (do ((val vals (tn-ref-across val))
  55.      (i 0 (1+ i)))
  56.     ((null val))
  57.       (let ((tn (tn-ref-tn val)))
  58.     (sc-case tn
  59.       (descriptor-reg
  60.        (storew tn start-temp i))
  61.       (control-stack
  62.        (load-stack-tn temp tn)
  63.        (storew temp start-temp i)))))
  64.     (move start start-temp)
  65.     (inst li count (fixnum nvals))))
  66.  
  67.  
  68. ;;; Push a list of values on the stack, returning Start and Count as used in
  69. ;;; unknown values continuations.
  70. ;;;
  71. (define-vop (values-list)
  72.   (:args (arg :scs (descriptor-reg) :target list))
  73.   (:arg-types list)
  74.   (:policy :fast-safe)
  75.   (:results (start :scs (any-reg))
  76.         (count :scs (any-reg)))
  77.   (:temporary (:scs (descriptor-reg) :type list :from (:argument 0)) list)
  78.   (:temporary (:scs (descriptor-reg)) temp)
  79.   (:temporary (:scs (non-descriptor-reg) :type random) ndescr)
  80.   (:vop-var vop)
  81.   (:save-p :compute-only)
  82.   (:generator 0
  83.     (let ((loop (gen-label))
  84.       (done (gen-label)))
  85.  
  86.       (move list arg)
  87.       (move start csp-tn)
  88.  
  89.       (emit-label loop)
  90.       (inst beq list null-tn done)
  91.       (loadw temp list vm:cons-car-slot vm:list-pointer-type)
  92.       (loadw list list vm:cons-cdr-slot vm:list-pointer-type)
  93.       (inst addu csp-tn csp-tn vm:word-bytes)
  94.       (storew temp csp-tn -1)
  95.       (test-simple-type list ndescr loop nil vm:list-pointer-type)
  96.       (error-call vop bogus-argument-to-values-list-error list)
  97.  
  98.       (emit-label done)
  99.       (inst subu count csp-tn start))))
  100.  
  101.